home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1996 #15
/
Monster Media Number 15 (Monster Media)(July 1996).ISO
/
tbbs
/
prgsourc.zip
/
EVENTS.ZIP
/
SORT.PRG
< prev
next >
Wrap
Text File
|
1996-04-24
|
6KB
|
221 lines
SET COLOR TO W+/N
SET DELETED ON
buf = 2048
k = " "
SELECT a
USE sort INDEX sortord
SELECT b
USE week
SELECT c
USE month
f = 0
DO WHILE f <= 30
cd = Date()+f
d = DtoC(cd)
dw = Upper(SubStr(cDoW(cd),1,3))
md = Day(cd)
dn = Ceiling(md/7)
df = HomePath() + "DAY\" + SubStr(d,1,2) + SubStr(d,4,2) + SubStr(d,7,2) + ".TXT"
***********************************************************
@ 0,5 SAY "Processing Events for " + d
******************************** Get events from newev.dbf
SELECT a
@ 1,5 SAY "Adding new events to sort"
APPEND FROM newev FOR sd = cd
******************************** Get events from day file
IF File(df)
@ 2,5 SAY "Adding old events to sort"
APPEND FROM (df) DELIMITED
ENDIF
******************************** Get events from week.dbf
SELECT b
GOTO TOP
COUNT TO cnt
IF cnt # 0
@ 3,5 SAY "Adding weekly events to sort"
GOTO TOP
x = 1
DO WHILE .T.
IF day = dw
SELECT a
APPEND BLANK
REPLACE sd WITH cd, ed WITH cd
REPLACE sth WITH b->sth, eth WITH b->eth, ca WITH b->ca, cu WITH b->cu, cc WITH b->cc
REPLACE stm WITH b->stm, etm WITH b->etm, sap WITH b->sap, eap WITH b->eap
REPLACE cty WITH b->cty, stat WITH b->stat, phn WITH b->phn
REPLACE ev WITH b->ev, loc WITH b->loc, dsc1 WITH b->dsc1, dsc2 WITH b->dsc2
REPLACE owner WITH b->owner, poster WITH b->poster
REPLACE subject WITH b->subject, sb WITH b->sb
SELECT b
ENDIF
IF x = cnt
EXIT
ENDIF
SKIP
x = x + 1
ENDDO
ENDIF
******************************** Get events from month.dbf
SELECT c
GOTO TOP
COUNT TO cnt
IF cnt # 0
@ 4,5 SAY "Adding monthly events to sort"
GOTO TOP
x = 1
DO WHILE .T.
ok = .F.
IF day = "MON" .OR. day = "TUE" .OR. day = "WED" .OR. day = "THU" .OR. day = "FRI" .OR. day = "SAT" .OR. day = "SUN" .AND. dayn < 6
IF day = dw .AND. dn = dayn
ok = .T.
ENDIF
ELSE
IF md = dayn
ok = .T.
ENDIF
ENDIF
IF ok
SELECT a
APPEND BLANK
REPLACE sd WITH cd, ed WITH cd
REPLACE sth WITH c->sth, eth WITH c->eth, ca WITH c->ca, cu WITH c->cu, cc WITH c->cc
REPLACE stm WITH c->stm, etm WITH c->etm, sap WITH c->sap, eap WITH c->eap
REPLACE cty WITH c->cty, stat WITH c->stat, phn WITH c->phn
REPLACE ev WITH c->ev, loc WITH c->loc, dsc1 WITH c->dsc1, dsc2 WITH c->dsc2
REPLACE owner WITH c->owner, poster WITH c->poster
REPLACE subject WITH c->subject, sb WITH c->sb
SELECT c
ENDIF
IF x = cnt
EXIT
ENDIF
SKIP
x = x + 1
ENDDO
ENDIF
******************************** Create .DAY file
SELECT a && sort.dbf sortord.ndx
GOTO TOP
COUNT TO i
@ 5,5 SAY "Creating .DAY file"
GOTO TOP
IF i = 0
dg = HomePath() + "DAY\" + SubStr(d,1,2) + SubStr(d,4,2) + SubStr(d,7,2) + ".DAY"
IF File(dg)
ERASE dg
ENDIF
FCREATE day &dg 13 0 buf
ELSE
x = 1
DO WHILE .T.
o = 0
IF sap = "p"
o = 720
ENDIF
IF sth # 12
o = o + sth*60
ENDIF
o = o + Val(stm)
REPLACE ord WITH o
IF x = i
EXIT
ENDIF
x = x + 1
SKIP
ENDDO
GOTO TOP
IF File(df)
ERASE df
ENDIF
COPY TO (df) DELIMITED
GOTO TOP
dg = HomePath() + "DAY\" + SubStr(d,1,2) + SubStr(d,4,2) + SubStr(d,7,2) + ".DAY"
IF File(dg)
ERASE dg
ENDIF
FCREATE day &dg 13 0 buf
x = 1
DO WHILE .T.
sdt = DtoC(sd)
edt = DtoC(ed)
s = LTrim(Str(sb))
IF Len(s) < 3
s = " " + s
ENDIF
line = s + owner + subject + dsc1 + dsc2 + Chr(13) + Chr(10)
FLWRITE day z line
st = LTrim(Str(sth))
IF Len(st) < 2
st = " " + st
ENDIF
stime = st + ":" + stm + " " + sap + ".m."
et = LTrim(Str(eth))
IF Len(et) < 2
et = " " + et
ENDIF
etime = et + ":" + etm + " " + eap + ".m."
IF ca = 0
ga = " FREE "
ELSE
ga = "$" + Str(ca,6,2)
ENDIF
IF cu = 0
gu = " FREE "
ELSE
gu = "$" + Str(cu,6,2)
ENDIF
IF cc = 0
gc = "FREE"
ELSE
gc = "$" + Str(cc,6,2)
ENDIF
ph = "(" + SubStr(phn,1,3) + ")" + SubStr(phn,4,3) + "-" + SubStr(phn,7,4)
line = ev + loc + cty + stat + ph + ga + gu + gc + stime + etime + poster + Chr(13) + Chr(10)
FLWRITE day z line
IF x = i
EXIT
ENDIF
x = x + 1
SKIP
ENDDO
ENDIF
line = "@@@@@@@@@@@@@@@@@@@@@@@@@" + Chr(13) + Chr(10)
FLWRITE day z line
FCLOSE
@ 0,0 CLEAR TO 7,40
ZAP
f = f + 1
ENDDO
SELECT d
USE newev
COUNT TO i
GOTO TOP
x = 1
DO WHILE x <= i
IF sd <= cd
DELETE
ENDIF
IF x = i
EXIT
ENDIF
x = x + 1
SKIP
ENDDO
QUIT